home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / TrackingReplay-Shan.st < prev    next >
Text File  |  1993-07-24  |  12KB  |  434 lines
  1. EventQueue subclass: #TREventQueue
  2.     instanceVariableNames: 'trackingOrReplay rootModeOrg storage lastmsec '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'TrackingReplay-Shan'!
  6. TREventQueue comment:
  7. 'This is the event queue used for replay.  Shan 16 July 1990'!
  8.  
  9.  
  10. !TREventQueue methodsFor: 'control'!
  11.  
  12. disable
  13.     "Shan 18 July 1990"
  14.  
  15.     trackingOrReplay == #replay
  16.         ifTrue: [^self]
  17.         ifFalse: [super disable]!
  18.  
  19. enable
  20.     "Shan 18 July 1990"
  21.  
  22.     trackingOrReplay == #replay
  23.         ifTrue: [^self]
  24.         ifFalse: [super enable]!
  25.  
  26. terminateTracking
  27.     "Shan 18 July 1990"
  28.  
  29.     trackingOrReplay == #tracking ifTrue: [storage close].
  30.     trackingOrReplay _ nil! !
  31.  
  32. !TREventQueue methodsFor: 'access'!
  33.  
  34. nextPut: value 
  35.     "The time kept in the msec is relative. It is defined as T(previous 
  36.     event) - T(current event). Shan 18 July 1990"
  37.  
  38.     | overflow newmsec interval  storedEvent |
  39.     overflow _ false.
  40.     accessProtect critical: [contents size > Limit
  41.             ifTrue: 
  42.                 ["contents _ OrderedCollection new. Transcript show: 
  43.                 'Event queue overflow\' withCRs Shan 11 June 1990"
  44.                 overflow _ true.
  45.                 self init: contents size]
  46.             ifFalse: [contents addLast: value]].
  47.     overflow
  48.         ifFalse: 
  49.             [readSynch signal.
  50.             "Added stuffs begin here. Shan 18 July 1990"
  51.             trackingOrReplay == #tracking
  52.                 ifTrue: 
  53.                     [storedEvent _ value deepCopy.
  54.                     newmsec _ Time millisecondClockValue.
  55.                     lastmsec isNil
  56.                         ifTrue: 
  57.                             [lastmsec _ 0.
  58.                             interval _ 0]
  59.                         ifFalse: [interval _ newmsec - lastmsec].
  60.                     storedEvent msec: interval.
  61.                     lastmsec _ newmsec.
  62.                     storedEvent origin: value origin - rootModeOrg.
  63.                     storedEvent previousOrigin: value previousOrigin - rootModeOrg.
  64.                     storage nextPut: storedEvent].
  65.             trackingOrReplay == #replay
  66.                 ifTrue: 
  67.                     ["Adjust the coordinates."
  68.                     value origin: value origin + rootModeOrg.
  69.                     value previousOrigin: value previousOrigin + rootModeOrg]].
  70.     last _ value deepCopy.
  71.     ^value!
  72.  
  73. rootModeOrigin 
  74.     "Shan 18 July 1990"
  75.  
  76.     ^rootModeOrg!
  77.  
  78. rootModeOrigin: pt 
  79.     "Shan 18 July 1990"
  80.  
  81.     rootModeOrg _ pt!
  82.  
  83. storage
  84.     "Shan 18 July 1990"
  85.  
  86.     ^storage!
  87.  
  88. storage: s
  89.     "Shan 18 July 1990"
  90.  
  91.     storage _ s!
  92.  
  93. trackingOrReplay
  94.     "This can be of values #tracking or #replay.  Shan 18 July 1990"
  95.  
  96.     ^trackingOrReplay!
  97.  
  98. trackingOrReplay: tOrR
  99.     "This can be of values #tracking or #replay.  Shan 18 July 1990"
  100.  
  101.     trackingOrReplay _ tOrR! !
  102.  
  103. SNATextController subclass: #SNATextControllerEd
  104.     instanceVariableNames: ''
  105.     classVariableNames: ''
  106.     poolDictionaries: ''
  107.     category: 'TrackingReplay-Shan'!
  108.  
  109.  
  110. !SNATextControllerEd methodsFor: 'basic control sequence'!
  111.  
  112. controlLoop
  113.     "Combine the controlLoop and the controlActivity. Shan 18 July 1990"
  114.  
  115.     | event eq |
  116.     eq _ self eventQueue.
  117.     eq enable.
  118.     [self isControlActive]
  119.         whileTrue: 
  120.             [event _ eq next.
  121.             (self scrollBarContainsCursor: event)
  122.                 ifTrue: [self scroll: event]
  123.                 ifFalse: [event selector == #keyboardEvent
  124.                         ifTrue: [self readKeyboard: event]
  125.                         ifFalse: [self processMouseButtons: event]]].
  126.     eq disable! !
  127.  
  128. !SNATextControllerEd methodsFor: 'event driven'!
  129.  
  130. processMouseButtons: e 
  131.     "Shan 15 July 1990"
  132.  
  133.     e leftButtonDown ifTrue: [self processRedButton: e].
  134.     e middleButtonDown
  135.         ifTrue: 
  136.             [self eventQueue disable.
  137.             self processYellowButton.
  138.             self eventQueue enable].
  139.     e rightButtonDown ifTrue: [self processBlueButton]!
  140.  
  141. processRedButton: e
  142.     "This is a simple one.  Does not handle drag and double click.  Shan 15 July 1990"
  143.  
  144.     | selectionBlocks block |
  145.     self deselect.
  146.     self closeTypeIn.
  147.     block _ paragraph characterBlockAtPoint: e origin.
  148.     paragraph displayCaretForBlock: block.
  149.     selectionBlocks _ Array with: block with: block.
  150.     selectionShowing _ true.
  151.     startBlock _ selectionBlocks at: 1.
  152.     stopBlock _ selectionBlocks at: 2.
  153.     self updateMarker.
  154.     self setEmphasisHere!
  155.  
  156. readKeyboard: e 
  157.     "Shan 30 June 1990"
  158.  
  159.     | typeAhead currentCharacter mEvent |
  160.     self deselect.
  161.     typeAhead _ WriteStream on: (String new: 128).
  162.     beginTypeInBlock == nil
  163.         ifTrue: 
  164.             [UndoSelection _ self selection.
  165.             beginTypeInBlock _ startBlock copy].
  166.     mEvent _ e.
  167.     
  168.     [CurrentEvent _ mEvent keyboardEvent.
  169.     currentCharacter _ CurrentEvent keyCharacter.
  170.     (self
  171.         perform: (Keyboard at: currentCharacter asciiValue + 1)
  172.         with: typeAhead
  173.         with: currentCharacter)
  174.         ifTrue: [^self].
  175.     mEvent _ self eventQueue peek.
  176.     (mEvent notNil and: [mEvent selector == #keyboardEvent])
  177.         ifTrue: 
  178.             [self eventQueue next.
  179.             true]
  180.         ifFalse: [false]] whileTrue.
  181.     self replaceSelectionWith: (Text string: typeAhead contents emphasis: emphasisHere).
  182.     startBlock _ stopBlock copy.
  183.     self selectAndScroll!
  184.  
  185. scroll: e
  186.     "Shan 1 July 1990"
  187.     | savedCursor regionPercent mEvent eq |
  188.     "self yellowMenuContainsCursor
  189.                 ifTrue: [^self yellowMenuActivity]."
  190.     savedCursor _ sensor currentCursor.
  191.     eq _ self eventQueue.
  192.     mEvent _ e.
  193.     [self scrollBarOnlyArea containsPoint: mEvent origin]
  194.         whileTrue: 
  195.             [Processor yield.  "Shan 15 July 1990"
  196.             regionPercent _ 100 * (mEvent origin x - scrollBar left) // scrollBar width.
  197.             regionPercent <= 40
  198.                 ifTrue: [self scrollDownEd: mEvent]
  199.                 ifFalse: [regionPercent >= 60
  200.                             ifTrue: [self scrollUpEd: mEvent]
  201.                             ifFalse: [self scrollAbsoluteEd: mEvent]].
  202.             mEvent _ eq nextWithCursorMoveCompressed.  "Shan 16 July 1990"].
  203.     savedCursor show!
  204.  
  205. scrollAbsoluteEd: e
  206.  
  207.     | oldMarker delta newMarkerRegion oldCursorY cursorY offsetY eq mEvent |
  208.     self changeCursor: Cursor marker.
  209.     oldCursorY _ marker center y.
  210.     eq _ self eventQueue.  "Shan 16 July 1990"
  211.     mEvent _ e.
  212.     self canScroll & e anyButtonDown ifTrue:
  213.         [[mEvent anyButtonDown] whileTrue:
  214.             [oldMarker _ marker copy.
  215.             cursorY _ mEvent origin y.
  216.             delta _ ((marker center y - cursorY) asFloat / self scrollBarOnlyArea height asFloat 
  217.                         * (paragraph textSize max: 1) asFloat) truncated.
  218.             (oldCursorY - cursorY) * delta <= 0 ifTrue: [delta _ 0].
  219.             self scrollView: delta.
  220.             oldCursorY _ cursorY.
  221.             newMarkerRegion _ self computeMarkerRegion.
  222.             offsetY _ (((paragraph lines at: 1) - 1) asFloat 
  223.                             / (paragraph textSize max: 1) asFloat 
  224.                                 * self scrollBarOnlyArea height asFloat) rounded 
  225.                                     min: self scrollBarOnlyArea height - newMarkerRegion height. 
  226.             marker region: (marker left@(self scrollBarOnlyArea top + offsetY) extent: newMarkerRegion corner).
  227.             (oldMarker areasOutside: marker), (marker areasOutside: oldMarker) do:
  228.                 [:region | Display fill: region rule: Form reverse mask: Form gray].
  229.             mEvent _ eq nextWithCursorMoveCompressed].
  230.         self displayScrollBar.
  231.         self moveMarker]!
  232.  
  233. scrollBarContainsCursor: e 
  234.     "Shan 30 June 1990"
  235.  
  236.     ^scrollBar containsPoint: e origin!
  237.  
  238. scrollDownEd: e 
  239.     "Use the name 'scrollDownEd' to avoid confusion with other 
  240.     implementations of 'scrollDown:'. Shan 15 July 1990"
  241.  
  242.     self changeCursor: Cursor down.
  243.     e anyButtonDown ifTrue: [self canScroll
  244.             ifTrue: 
  245.                 [self scrollViewDown.
  246.                 self updateMarker]].
  247.     self eventQueue waitNoButton!
  248.  
  249. scrollUp: e 
  250.     "Shan 15 July 1990"
  251.  
  252.     self changeCursor: Cursor up.
  253.     e anyButtonDown ifTrue: [self canScroll
  254.             ifTrue: 
  255.                 [self scrollViewUp.
  256.                 self updateMarker]].
  257.     self eventQueue waitNoButton!
  258.  
  259. scrollUpEd: e 
  260.     "Use the name 'scrollUpEd' to avoid confusion with other 
  261.     implementations of 'scrollUp:'. Shan 15 July 1990"
  262.  
  263.     self changeCursor: Cursor up.
  264.     e anyButtonDown ifTrue: [self canScroll
  265.             ifTrue: 
  266.                 [self scrollViewUp.
  267.                 self updateMarker]].
  268.     self eventQueue waitNoButton! !
  269.  
  270. !SNATextControllerEd methodsFor: 'control defaults'!
  271.  
  272. controlActivity
  273.     "See if I can make it event-driven. Shan 30 June 1990"
  274.  
  275.     | event |
  276.     event _ self eventQueue next.
  277.     (self scrollBarContainsCursor: event)
  278.         ifTrue: [self scroll: event]
  279.         ifFalse: [event selector == #keyboardEvent
  280.                 ifTrue: [self readKeyboard: event]
  281.                 ifFalse: [self processMouseButtons: event]]!
  282.  
  283. isControlActive
  284.     "Collapse all methods defined in the superclasses.  Shan 18 July 1990"
  285.  
  286.     | eq |
  287.     eq _ self eventQueue.
  288.     ^wantControl & eq rightButtonDown not & ((view containsPoint: eq mousePoint)
  289.             | (scrollBar containsPoint: eq mousePoint))! !
  290.  
  291. !SNATextControllerEd methodsFor: 'tracking/replay'!
  292.  
  293. eventQueue
  294.     "Shan 15 July 1990"
  295.  
  296.     ^view topView controller eventQueue! !
  297. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  298.  
  299. SNATextControllerEd class
  300.     instanceVariableNames: ''!
  301.  
  302.  
  303. !SNATextControllerEd class methodsFor: 'testing'!
  304.  
  305. editorTrackingtest
  306.     "Shan 18 July 1990"
  307.     "(RootMode new addSubMode: self editorTrackingtest) startUp"
  308.  
  309.     | pView aPollingEnvMode w rMode |
  310.     rMode _ ExpandedMode new.
  311.     pView _ SNATextView
  312.                 on: (SNAText fileName: 'temp')
  313.                 aspect: #text
  314.                 change: #acceptText:from:
  315.                 menu: #textMenu.
  316.     pView controller: SNATextControllerEd new.
  317.     pView borderWidth: (1 @ 1 corner: 1 @ 1).    "Shan March 21, 1990"
  318.     aPollingEnvMode _ PollingEnvMode new.
  319.     aPollingEnvMode addSubView: pView.
  320.     w _ SNATextWindow new.
  321.     w applicationMode: aPollingEnvMode.
  322.     w mode extent: 150 @ 150.
  323.     w initialOpen.
  324.     rMode addSubMode: w mode at: 40@40.
  325.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  326.  
  327. test
  328.     "Shan 1 July 1990"
  329.     "self test"
  330.  
  331.     | pView aPollingEnvMode w rMode |
  332.     rMode _ RootMode new.
  333.     pView _ SNATextView
  334.                 on: (SNAText fileName: 'temp')
  335.                 aspect: #text
  336.                 change: #acceptText:from:
  337.                 menu: #textMenu.
  338.     pView controller: SNATextControllerEd new.
  339.     pView borderWidth: (1 @ 1 corner: 1 @ 1).    "Shan March 21, 1990"
  340.     aPollingEnvMode _ PollingEnvMode new.
  341.     aPollingEnvMode addSubView: pView.
  342.     w _ SNATextWindow new.
  343.     w applicationMode: aPollingEnvMode.
  344.     w mode extent: 150 @ 150.
  345.     w initialOpen.
  346.     rMode addSubMode: w mode.
  347.     rMode startUp! !
  348.  
  349. Object subclass: #TrackReplay
  350.     instanceVariableNames: ''
  351.     classVariableNames: ''
  352.     poolDictionaries: ''
  353.     category: 'TrackingReplay-Shan'!
  354.  
  355. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  356.  
  357. TrackReplay class
  358.     instanceVariableNames: ''!
  359.  
  360.  
  361. !TrackReplay class methodsFor: 'track and replay'!
  362.  
  363. replay3
  364.     "Shan 18 July 1990"
  365.     "self replay3"
  366.  
  367.     | aFileName fstorage event replayQueue rmode |
  368.     aFileName := 't'.
  369.     fstorage _ BinaryStorage read: aFileName asFilename readStream.
  370.     rmode _ RootMode new addSubMode: TestExamples oddShapeAndAnimationTest.
  371.     replayQueue _ TREventQueue new.
  372.     replayQueue trackingOrReplay: #replay.
  373.     rmode eventQueue: replayQueue.
  374.     [[fstorage atEnd]
  375.         whileFalse: 
  376.             [event _ fstorage next.
  377.             (Delay forMilliseconds: event msec) wait.
  378.             replayQueue nextPut: event]] fork.
  379.     rmode startUp!
  380.  
  381. replay4
  382.     "Shan 18 July 1990"
  383.     "self replay4"
  384.  
  385.     | trackfile fstorage event replayQueue rmode |
  386.     trackfile := FillInTheBlank request: 'File name for tracking ' initialAnswer: ''.
  387.     fstorage _ BinaryStorage read: trackfile asFilename readStream.
  388.     rmode _ RootMode new addSubMode: SNATextControllerEd editorTrackingtest.
  389.     replayQueue _ TREventQueue new.
  390.     replayQueue trackingOrReplay: #replay.
  391.     rmode eventQueue: replayQueue.
  392.     [[fstorage atEnd]
  393.         whileFalse: 
  394.             [event _ fstorage next.
  395.             (Delay forMilliseconds: event msec) wait.
  396.             replayQueue nextPut: event].
  397.             rmode stopRunning] fork.
  398.     rmode startUp!
  399.  
  400. tracking3
  401.     "Shan 18 July 1990"
  402.     "self tracking3"
  403.  
  404.     | trackfile storage rmode |
  405.     "trackfile := FillInTheBlank request: 'File name for tracking ' initialAnswer: ''.
  406.     trackfile asFilename exists
  407.         ifTrue: 
  408.             [(self confirm: 'File already exists.  Proceed to overwrite?')
  409.                 ifFalse: [^self]]."
  410.     storage _ BinaryStorage write: "trackfile" 't' asFilename writeStream.
  411.     rmode _ RootMode new addSubMode: TestExamples oddShapeAndAnimationTest.
  412.     EventQ _ TREventQueue new.
  413.     EventQ trackingOrReplay: #tracking.
  414.     EventQ storage: storage.
  415.     rmode eventQueue: EventQ.
  416.     rmode startUp!
  417.  
  418. tracking4
  419.     "Shan 18 July 1990"
  420.     "self tracking4"
  421.  
  422.     | trackfile storage rmode |
  423.     trackfile := FillInTheBlank request: 'File name for tracking ' initialAnswer: ''.
  424.     trackfile asFilename exists
  425.         ifTrue: 
  426.             [(self confirm: 'File already exists.  Proceed to overwrite?')
  427.                 ifFalse: [^self]].
  428.     storage _ BinaryStorage write: trackfile asFilename writeStream.
  429.     rmode _ RootMode new addSubMode: SNATextControllerEd editorTrackingtest.
  430.     EventQ _ TREventQueue new.
  431.     EventQ trackingOrReplay: #tracking.
  432.     EventQ storage: storage.
  433.     rmode eventQueue: EventQ.
  434.     rmode startUp! !